package clnet;

use warnings;
use Sys::Hostname;
use Net::Ping;
use ipinterfaces;

BEGIN {
	use Exporter ();
	our ($VERSION, @ISA, @EXPORT, @EXPORT_OK);

	$VERSION=0.1;
	@ISA	= qw(Exporter);
	@EXPORT_OK = qw(
		&CLNET_check_cards_exist
		&CLNET_check_networks
		&CLNET_check_one_ip
		&CLNET_get_network_list
		&CLNET_return_static_ips
		&CLNET_return_network_static_ip
		&CLNET_assign_network_ips
		&CLNET_unassign_network_ips
		&CLNET_assign_ips
		&CLNET_unassign_ips
		&CLNET_check_ping
		&CLNET_migrate_ips
		&CLNET_map_ip_to_network
		&CLNET_check_cards_unique
		&CLNET_get_network_attributes
		&_gen_ip_list
	);
	@EXPORT = ();
	$exit_handler=undef;
}
our @EXPORT_OK;

eval { require "miitoollib.pm"; } ;

sub _CLNET_get_card_list {
my %args=@_;
my ($cards,$xml);

	if(!exists($args{network}) || !exists($args{node}) || !exists($args{xml})) {
		return(0,"Missing mandatory argument.");
	}
	$xml=$args{xml};
	if(!exists($xml->{node}->{$args{node}})) {
		return(0,"Missing node details for node ".$args{node});
	}
	if(!exists($xml->{node}->{$args{node}}->{network})) {
		return(0,"Missing node network details for node ".$args{node});
	}
	if(exists($xml->{node}->{$args{node}}->{network}->{name})) {
		if($args{network} ne $xml->{node}->{$args{node}}->{network}->{name}) {
			return(0,"Unknown network ".$args{network}." on node ".$args{node});
		}
		if(!exists($xml->{node}->{$args{node}}->{network}->{cards})) {
			return(0,"Missing cards element for network ".$args{network}." on node ".$args{node});
		}
		$cards=$xml->{node}->{$args{node}}->{network}->{cards};
	} else {
		if(!exists($xml->{node}->{$args{node}}->{network}->{$args{network}})) {
			return(0,"Unknown network ".$args{network}." on node ".$args{node});
		}
		if(!exists($xml->{node}->{$args{node}}->{network}->{$args{network}}->{cards})) {
			return(0,"Missing cards element for network ".$args{network}." on node ".$args{node});
		}
		$cards=$xml->{node}->{$args{node}}->{network}->{$args{network}}->{cards};
	}

	#################################################################
	# At this point the cards variable holds the list of cards for	#
	# this network, so return them...				#
	#################################################################
	return(1,$cards);
}

#########################################################################
# check_one_ip([node=>"node"],network=>"X",XML=>"z")			#
# This will return whether the specified node on the specified		#
# network has one and only one IP address on a physical card. It will	#
# returns (1,$card,$ip) - if exactly 1 found.				#
#         (0,err,...) otherwise						#
#########################################################################

sub CLNET_check_one_ip {
my %args=@_;
my ($res,$cards);
my ($ipinters,@ints);
my ($found,$acard,$aip);
my @errs=();

	if(!exists($args{node})) {
		$args{node}=hostname;
	}
	($res,$cards)=_CLNET_get_card_list(%args);
	if(!$res) {
		return($res,$cards);
	}

	#################################################################
	# Cards is the comma separated list of cards, so check that	#
	# one and only one has a IP address...				#
	#################################################################
	
	if($args{node} ne hostname) {
		$ipinters=ipinterfaces->new(remote => $args{node});
	} else {
		$ipinters=ipinterfaces->new;
	}
	$ipinters->scan_interfaces;
	@ints=$ipinters->list(physical=>1);

	#################################################################
	# We must emsure that if more than one card is listed, only	#
	# one has an {ip} element...					#
	#################################################################
	$found=0;
	for $card (split(/,/,$cards)) {
		my $cinter;
		if(scalar(grep {/^$card$/} @ints)) {
			$cinter=$ipinters->get_details(interface=>"$card:0");
			if(defined($cinter) && exists($cinter->{ip})) {
				($acard,$aip)=($card,$cinter->{ip});
				$found++;
				push @errs,"Found IP address $aip on interface $acard.";
			}
		}
	}
	return(0,@errs) if $found>1;
	return(0,"No IP addresses found!") if !$found;
	return(1,$acard,$aip);
}

#########################################################################
# check_cards_exist(network=>"X",node=>"y",XML=>"z")			#
# Returns list of two references to arrays - first one containing	#
# cards that do exist, the 2nd containing the cards that do not		#
# exist.								#
#########################################################################

sub CLNET_check_cards_exist {
my %args=@_;
my ($res,$cards);
my ($ipinters,@ints);
my (@found,@nfound);

	($res,$cards)=_CLNET_get_card_list(@_);
	if(!$res) {
		return(undef,undef);
	}
	$ipinters=ipinterfaces->new;
	@ints=$ipinters->list(physical=>1,all=>1);
	@found=();
	@nfound=();
	for $card (split(/,/,$cards)) {
		my $cinter;
		if(scalar(grep {/^$card$/} @ints)) {
			push @found,$card;
		} else {
			push @nfound,$card;
		}
	}
	return(\@found,\@nfound);
}

#########################################################################
# This will return (attributes,error) for the speccified network on	#
# the specified host.							#
# If no attributes are defined will return (undef,undef) - or if an	#
# error occurs will return (undef,error).				#
#########################################################################

sub CLNET_get_network_attributes {
my %args=@_;
my $xml;

	if(!exists($args{network}) || !exists($args{node}) || 
		!exists($args{xml})) {
		return(undef,"Missing mandatory argument.");
	}
	$xml=$args{xml};
	if(!exists($xml->{node}->{$args{node}})) {
		return(undef,"Missing node details for node ".$args{node});
	}
	if(!exists($xml->{node}->{$args{node}}->{network})) {
		return(0,"Missing node network details for node ".$args{node});
	}
	if(exists($xml->{node}->{$args{node}}->{network}->{name})) {
		if($xml->{node}->{$args{node}}->{network}->{name} ne $args{network}) {
			return(undef,"No such network defined.");
		}
		if(exists($xml->{node}->{$args{node}}->{network}->{attributes})) {
			return($xml->{node}->{$args{node}}->{network}->{attributes},undef);
		}
		return(undef,undef);
	}
	if(exists($xml->{node}->{$args{node}}->{network}->{$args{network}})) {
		if(exists($xml->{node}->{$args{node}}->{network}->{$args{network}}->{attributes})) {
			return($xml->{node}->{$args{node}}->{network}->{$args{network}}->{attributes},undef);
		}
		return(undef,undef);
	}
	return(undef,"No such network defined.");
}

#########################################################################
# get_network_list(node=>"y",xml=>"z")					#
# Returns a list of network names that have been defined in the		#
# XML file for the node in question. Results is (1|0,a,b,c...)		#
# If 0 (error), then a == error message.				#
#########################################################################

sub CLNET_get_network_list {
my %args=@_;
my $xml;

	if(!exists($args{node}) || !exists($args{xml})) {
		return(0,"Missing mandatory argument.");
	}
	$xml=$args{xml};
	if(!exists($xml->{node}->{$args{node}})) {
		return(0,"Missing node details for node ".$args{node});
	}
	if(!exists($xml->{node}->{$args{node}}->{network})) {
		return(0,"Missing node network details for node ".$args{node});
	}
	if(exists($xml->{node}->{$args{node}}->{network}->{name})) {
		return(1,$xml->{node}->{$args{node}}->{network}->{name});
	}
	return(1,sort(keys(%{$xml->{node}->{$args{node}}->{network}})));
}

sub CLNET_check_cards_unique {
my %args=@_;
my $xml;
my ($res,@nets);

	$xml=$args{xml};
	($res,@nets)=CLNET_get_network_list(%args);
	return($res,@nets) if $res==0;

	my %cards=();
	my $cnet;
	my @F; my @errs=();
	for $cnet (@nets) {
		if(exists($xml->{node}->{$args{node}}->{network}->{name})) {
			@F=split(/,/,$xml->{node}->{$args{node}}->{network}->{cards});
		} else {
			@F=split(/,/,$xml->{node}->{$args{node}}->{network}->{$cnet}->{cards});
		}
		for (@F) {
			if(exists($cards{$_})) {
				push @errs,"Card $_ in $cnet already defined for network $cards{$_}.";
			} else {
				$cards{$_}=$cnet;
			}
		}
	}
	return(1) if !@errs;
	return(0,@errs);
}

#########################################################################
# check_netmasks (xml=>xml,[node=>remotenodename])			#
# This will check to ensure that every interface with an IP address	#
# on the specified node (just looking at physical interfaces) is	#
# on a separate network.						#
# Returns (1) or (0,"err",..)						#
#########################################################################

sub CLNET_check_networks {
my %args=@_;
my (%nets,$ipinters,@ints,@errs,@ok);

	%nets=();
	@errs=();
	@ok=();
	if(exists($args{node}) && $args{node} ne hostname) {
		$ipinters=ipinterfaces->new(remote => $args{node});
	} else {
		$ipinters=ipinterfaces->new;
	}
	$ipinters->scan_interfaces;
	@ints=$ipinters->list(physical=>1);
	for (@ints) {
		my $ref;

		$ref=$ipinters->get_details(interface=>"$_:0");
		if(defined($ref) && exists($ref->{network})) {
			if(!exists($nets{$ref->{network}})) {
				$nets{$ref->{network}}=[];
			}
			push @{$nets{$ref->{network}}},$_;
		}
	}
	for (sort(keys(%nets))) {
		if(scalar(@{$nets{$_}})>1) {
			push @errs,"Cards ".join(",",@{$nets{$_}})." share network $_";
		} else {
			push @ok,"Interface ".${$nets{$_}}[0]." is on network $_";
		}
	}
	if($#errs==-1) {
		return(1,@ok);
	}
	return(0,@errs);
}

#########################################################################
# This will return the IP associated with the remote node - does so	#
# by reading the local /etc/cluster/.networks file if it exists and	#
# returns them as a list of IP addresses.				#
#########################################################################

sub CLNET_return_static_ips {
my %args=@_;
my ($fd,$cline,@ips,@F);

	return() if !exists($args{node});
	@ips=();
	if(! -f "/etc/cluster/.networks") {
		return ();
	}
	open($fd,"/etc/cluster/.networks");
	while($cline=<$fd>) {
		chomp $cline;
		@F=split(/:/,$cline);
		next if $F[0] ne $args{node};
		push @ips,$F[2];
	}
	close($fd);
	return (@ips);
}

sub CLNET_return_network_static_ip {
my %args=@_;
my ($fd,$cline,$ip,@F);

	return undef if !exists($args{node});
	return undef if !exists($args{network});
	if(! -f "/etc/cluster/.networks") {
		return undef;
	}
	open($fd,"/etc/cluster/.networks");
	while($cline=<$fd>) {
		chomp $cline;
		@F=split(/:/,$cline);
		next if $F[0] ne $args{node};
		next if $F[1] ne $args{network};
		$ip=$F[2]; last;
	}
	close($fd);
	return $ip
}

#########################################################################
# assign_ips(xml="x",appxml=>"y",network="z")				#
# Will assign all IP addresses (ignoring if already assigned) for the	#
# specified application and network on the local host. Will return	#
# (1) - ok or (0,err,...) if error.					#
# Note: It is the responsibility of the call to get a lock on the	#
# 	NET resource before making use of this routine.			#
#	The code here is based on the similar code found in the		#
#	ipinterfaces module (that code will be removed).		#
#									#
# 1.1.x series changes							#
# An optional rebuild=>1 can be sent if a IP addressing rebuild for	#
# the network in question is considered. Normally the IP addresses	#
# associated with the application are simply set based on the config	#
# with any existing /etc/cluster/.resoures/ips/app-net-IP files being	#
# deleted first.							#
#									#
# When rebuild=>1 is set then the files are left in place, and a first	#
# run through checks files against IP's for the application. If any	#
# files are found for no IP's then the IP in question is dropped.	#
#									#
# At that point the offending file is removed and then the process of	#
# adding IP's as normal is performed.					#
#########################################################################

sub _bits_to_mask($) {
my $b=$_[0];

	if($b =~ /\./) { return $b};

	my $mask=0xFFFFFFFF - ((1<<32-$b)-1);
	my @v=();
	for(0..3) {
		unshift @v,$mask&0xff;
		$mask=$mask>>8;
	}
	return join(".",@v);
}

sub _gen_ip_list($) {
my $ips=$_[0];
my %netmasks=();

	#########################################################
	# Cater for the special occurance of when a network 	#
	# consists of MONITOR...				#
	#########################################################
	if(uc($ips) eq "MONITOR") {
		return ("",{});
	}

	my $first="";
	my @x=split(/,/,$ips);
	$ips="";
	for(@x) {
		my $m=undef;
		if(/\/(.*)/) {
			$m=_bits_to_mask($1);
			s/\/.*//;
		}
		my ($a,$b,$c,$d,@j)=split(/\./,$_);
		if(defined($a) && defined($b) && defined($c)) {
			$first="$a.$b.$c";
		}
		if(/(\d+)\-(\d+)$/) {
			my ($l1,$l2)=($1,$2);
			while($l1<=$l2) {
				$netmasks{"$first.$l1"}=$m if defined($m);
				$ips.=",$first.$l1";
				$l1++;
			}	
		} elsif(/^(\d+\.){1,}/) {
			$netmasks{$_}=$m if defined($m);
			$ips.=",$_";
		# } elsif(!defined($b)) {
		} else {
			$netmasks{"$first.$_"}=$m if defined($m);
			$ips.=",$first.$_";
		}
	}
	$ips=~s/^,//;
	return ($ips,{%netmasks});
}

sub CLNET_assign_network_ips {
my %args=@_;
my ($rc,@errs,$card,@nets);
my ($xml,$net,$f,$appxml,$ref,$chashref,$listref);
my ($ips,$cip,$ipinters,$cint);
my $use_miitoollib;
my $rebuild=0;
my $netm;

	if(!exists($args{xml}) || !exists($args{appxml}) || !exists($args{network})) {
		return(0,"Missing one or more mandatory arguments (xml,appxml or network).");
	}
	$xml=$args{xml};
	$appxml=$args{appxml};
	my $appname=$appxml->{global}->{name};
	$net=$args{network};

	if(exists($args{rebuild}) && defined($args{rebuild}) &&
		$args{rebuild}) {
		$rebuild=1;
	}

	if(!exists($appxml->{networks}) || !exists($appxml->{networks}->{network})) {
		return(1);	# no networks - no work to do!
	}

	$ref=ref($appxml->{networks}->{network});
	if($ref eq "HASH") {
		$listref=[$appxml->{networks}->{network}];
	} else {
		$listref=$appxml->{networks}->{network};
	}

	#################################################################
	# We now need to scan the list of networks looking for the one	#
	# that needs assigning.						#
	#################################################################

	$f=0;
	for (@$listref) {
		if(exists($_->{net}) && $_->{net} eq $net) {
			$f=1; $chashref=$_; last;
		}
	}
	if(!$f) {
		return(0,"Network $net not defined for application.");
	}

	#################################################################
	# Does the IP's directory exist, and if not create it, or	#
	# carry on without it.						#
	#################################################################

	my $ipfolder=1;
	if(! -d "/etc/cluster/.resources/ips") {
		mkdir "/etc/cluster/.resources/ips" or $ipfolder=0;
	}
	if($ipfolder && !$rebuild) {
		#########################################################
		# No rebuild, so remove any existing dir entries.	#
		#########################################################
		my @D=();
		my ($dfd,$cline);
		if(opendir($dfd,"/etc/cluster/.resources/ips")) {
			@D=readdir($dfd);
			close($dfd);
		}
		for (@D) {
			if(/^$appname-$net-/) {
				unlink "/etc/cluster/.resources/ips/$_";
			}
		}			
	}

	$ipinters=ipinterfaces->new;
	#################################################################
	# If performing a rebuild we need to get a list of IP		#
	# addresses that exist as files, but are not part of the	#
	# network IP list at present, since we need to remove them!	#
	#################################################################
	if($rebuild && $ipfolder) {
		my @D=();
		my ($dfd,$cline);
		if(opendir($dfd,"/etc/cluster/.resources/ips")) {
			@D=grep {/^$appname-$net-/} readdir($dfd);
			close($dfd);
		}

		#########################################################
		# If the complete network has been removed then we	#
		# do not filter @D at all, otherwise we need to		#
		# filter the list.					#
		#########################################################

		$f=0;
		if(exists($appxml->{networks}) && exists($appxml->{networks}->{network})) {
			$ref=ref($appxml->{networks}->{network});
			if($ref eq "HASH") {
				$listref=[$appxml->{networks}->{network}];
			} else {
				$listref=$appxml->{networks}->{network};
			}
			for (@$listref) {
				if(exists($_->{net}) && $_->{net} eq $net) {
					$f=1; $chashref=$_; last;
				}
			}
		}

		#########################################################
		# Network still exists, so build list of IP's to	#
		# understand which ones might need to be removed.	#
		#########################################################
		if($f) {
			my $ips=$chashref->{ip};
			($ips,$netm)=_gen_ip_list($ips);
			my $cip;
			my @CIPS=split(/,/,$ips);
			my @N=();
			for (@D) {
				my $x=$_;
				$x =~ s/^$appname-$net-//;
				if(!scalar(grep {/^$x$/} @CIPS)) {
					push @N,$x;
				}
			}
			@D=@N;

			#################################################
			# @N is the list of IP's to remove, so remove	#
			# the file and the IP address in question.	#
			#################################################
			for (@D) {
				my $cip=$_;
				unlink "/etc/cluster/.resources/ips/$appname-$net-$cip";

				#########################################
				# Get the interface details and remove	#
				# it.					#
				#########################################

				my $cint=$ipinters->get_interface(ip=>$cip);
				next if !defined($cint);

				my $cmd="ifconfig $cint down ";
				::logmsg("Removing $cip: $cmd") if defined(&::logmsg);
				$cmd.=" 2>&1";
				$r=`$cmd`; chomp $r;
				if($?>>8 && length($r)) {
					next if $r =~ /Cannot assign requested/; # dodgy non-error
					::logwarn("Unable to unassign IP address $cip from $cint") if defined(&::logwarn);
					::logwarn("Message from ifconfig: $r") if length($r) && defined(&::logwarn);
				}
			}
			#################################################
			# All IP's associated with the network that	#
			# are no longer in the config have now been	#
			# removed.					#
			#################################################
		}
	}
	$use_miitoollib=defined(&miitoollib::send_arp);
 
	#################################################################
	# Now check the net exists in the list of networks in the	#
	# cluster topology.						#
	#################################################################

	($rc,@nets)=CLNET_get_network_list(node=>hostname,xml=>$xml);
	if(!$rc) {
		return(0,"Unable to get network list from cluster topology!");
	}

	if(!scalar(grep {/^$net$/} @nets)) {
		return(0,"Network $net not defined in cluster topology!");
	}

	#################################################################
	# Firstly we need to know which interface card we need to 	#
	# assign the addresses to...					#
	#################################################################
	($rc,@errs)=CLNET_check_one_ip(node=>hostname,network=>$net,xml=>$xml);
	if(!$rc) {
		return(0,@errs);
	}
	$card=$errs[0];
	#################################################################
	# Now we have the ethernet card, we need to find a logical 	#
	# address that is not being used.				#
	#################################################################

	$ips=$chashref->{ip};
	#################################################################
	# ips might include multiple IP addresses, so if so we		#
	# deal with that now...						#
	# Also rather than just N,N also handle N-N for ranges.		#
	#################################################################
	($ips,$netm)=_gen_ip_list($ips);
	for $cip (split(/,/,$ips)) {
		next if ! length($cip);
		my $cmd;
		$cint=$ipinters->get_interface(ip=>$cip);
		#########################################################
		# If the IP address is already assigned then just	#
		# set the netmask - so any changes in the config	#
		# file are reflected in the actual IP details.		#
		#########################################################
		if(defined($cint)) {
			$cmd="";
			if(exists($netm->{$cip})) {
				$cmd="ifconfig $cint netmask ".$netm->{$cip};
			} elsif(exists($chashref->{netmask})) {
				$cmd="ifconfig $cint netmask $chashref->{netmask}";
			}
			if($cmd ne "") {
				::logmsg("Configuring $cip: $cmd") if defined(&::logmsg);
				$cmd.=" 2>&1";
				$r=`$cmd`; chomp $r;
				if($?>>8) {
					::logwarn("Unable to change netmask on IP address $cip!") if defined(&::logwarn);
				}
			}
			next;
		}

		#########################################################
		# Only get here if the specified IP address is not	#
		# assigned.						#
		# Now get a new interface number to assign to...	#
		#########################################################
		$cint=$ipinters->get_logical(always=>1,interface => $card);

		$cmd="ifconfig $card:$cint inet $cip ";
		if(exists($netm->{$cip})) {
			$cmd.=" netmask ".$netm->{$cip};
		} else {
			$cmd.=" netmask ".$chashref->{netmask} if exists($chashref->{netmask});
		}
		$cmd.=" broadcast ".$chashref->{broadcast} if exists($chashref->{broadcast});
		::logmsg("Configuring $cip: $cmd") if defined(&::logmsg);
		$cmd.=" 2>&1";
		$r=`$cmd`; chomp $r;
		if($?>>8) {
			return(0,"Unable to assign IP address $cip to $card:$cint");
		}

		#########################################################
		# Create the IP directory listing to help future	#
		# rebuilds.						#
		#########################################################

		if($ipfolder) {
			my $fd;
			open($fd,">/etc/cluster/.resources/ips/$appname-$net-$cip");
			close($fd) if defined($fd);
		}

		#########################################################
		# Now send out grat arp request for new IP address.	#
		#########################################################
		if($use_miitoollib) {
			::logmsg("Sending Builtin Gratuitous arp for $card:$cint") if defined(&::logmsg);
			$rc=miitoollib::send_arp("$card:$cint");
			if($rc ne "") {
				::logwarn("Gratuitous arp request failed (error below)") if defined(&::logwarn);
				::logwarn($rc) if defined(&::logwarn);
			}
		} elsif(-x "/sbin/cluster/tools/send_arp") {
			$cmd="/sbin/cluster/tools/send_arp $card:$instance";
			::logmsg("Sending Gratuitous arp: $cmd") if defined(&::logmsg);
			$r=`$cmd 2>&1`;
			if(defined($::APPLICATION_RC)) {
				$rc=$::APPLICATION_RC;
			} else {
				$rc=$?>>8;
			}
			if($rc) {
				::logwarn("Gratuitous arp request failed (error below)") if defined(&::logwarn);
				::logwarn($r) if defined(&::logwarn);
			}
		}
	}
	return(1);
}

#########################################################################
# unassign_ips(xml="x",appxml=>"y",network="z")				#
# Will unassign all IP addresses (ignoring if already unassigned) for 	#
# the specified application and network on the local host. Will return	#
# (1) - ok or (0,err,...) if error.					#
# Note: It is the responsibility of the call to get a lock on the	#
# 	NET resource before making use of this routine.			#
#	The code here is based on the similar code found in the		#
#	ipinterfaces module (that code will be removed).		#
#									#
# 1.1.x series								#
#									#
# If the ipfolder exists (/etc/cluster/.resource/ips) then any		#
# files for this application/network are removed when this routine	#
# is called.								#
#									#
#########################################################################

sub CLNET_unassign_network_ips {
my %args=@_;
my ($rc,@errs,$card,@nets);
my ($xml,$net,$f,$appxml,$ref,$chashref,$listref);
my ($ips,$cip,$ipinters,$cint,$netm);

	if(!exists($args{xml}) || !exists($args{appxml}) || !exists($args{network})) {
		return(0,"Missing one or more mandatory arguments (xml,appxml or network).");
	}
	$xml=$args{xml};
	$appxml=$args{appxml};
	$net=$args{network};

	#################################################################
	# Remove /etc/cluster/.resources/ips/ entries if possible.	#
	#################################################################
	if(-d "/etc/cluster/.resources/ips") {
		my $appname=$appxml->{global}->{name};
		my @D=();
		my ($dfd,$cline);
		if(opendir($dfd,"/etc/cluster/.resources/ips")) {
			@D=readdir($dfd);
			close($dfd);
		}
		for (@D) {
			if(/^$appname-$net-/) {
				unlink "/etc/cluster/.resources/ips/$_";
			}
		}			
	}


	if(!exists($appxml->{networks}) || !exists($appxml->{networks}->{network})) {
		return(1);	# no networks - no work to do!
	}

	$ref=ref($appxml->{networks}->{network});
	if($ref eq "HASH") {
		$listref=[$appxml->{networks}->{network}];
	} else {
		$listref=$appxml->{networks}->{network};
	}

	#################################################################
	# We now need to scan the list of networks looking for the one	#
	# that needs assigning.						#
	#################################################################

	$f=0;
	for (@$listref) {
		if(exists($_->{net}) && $_->{net} eq $net) {
			$f=1; $chashref=$_; last;
		}
	}
	if(!$f) {
		return(0,"Network $net not defined for application.");
	}
 
	#################################################################
	# Now check the net exists in the list of networks in the	#
	# cluster topology.						#
	#################################################################

	($rc,@nets)=CLNET_get_network_list(node=>hostname,xml=>$xml);
	if(!$rc) {
		return(0,"Unable to get network list from cluster topology!");
	}

	if(!scalar(grep {/^$net$/} @nets)) {
		return(0,"Network $net not defined in cluster topology!");
	}

	#################################################################
	# Firstly we need to know which interface card we need to 	#
	# remove IP addresses from. 					#
	#################################################################
	($rc,@errs)=CLNET_check_one_ip(node=>hostname,network=>$net,xml=>$xml);
	if(!$rc) {
		return(0,@errs);
	}
	$card=$errs[0];
	#################################################################
	# Now we have the ethernet card, we need to generate the list	#
	# IP addresses to check ready for searching for them.		#
	#################################################################

	$ipinters=ipinterfaces->new;
	$ips=$chashref->{ip};
	#################################################################
	# ips might include multiple IP addresses, so if so we		#
	# deal with that now...						#
	# Also rather than just N,N also handle N-N for ranges.		#
	#################################################################
	($ips,$netm)=_gen_ip_list($ips);
	for $cip (split(/,/,$ips)) {
		next if ! length($cip);
		my $cmd;
		$cint=$ipinters->get_interface(ip=>$cip);
		next if !defined($cint);

		$cmd="ifconfig $cint down ";
		::logmsg("Removing $cip: $cmd") if defined(&::logmsg);
		$cmd.=" 2>&1";
		$r=`$cmd`; chomp $r;
		if($?>>8 && length($r)) {
			next if $r =~ /Cannot assign requested/; # dodgy non-error
			return(0,"Unable to unassign IP address $cip from $cint - '$r'");
		}
	}
	return(1);
}

#########################################################################
# assign_ips(xml=>xml,appxml=>appxml)					#
# Use the assign_network_ips routine to assign all IP addresses 	#
# across all networks defined for the specified application on the	#
# local host.								#
# Returns(1) - ok, or (0,err,...) if errors.				#
#									#
# 1.1.x series								#
# It also passes through the rebuild=>1 if present to 			#
# CLNET_assign_network_ips						#
#########################################################################

sub CLNET_assign_ips {
my %args=@_;
my ($xml,$appxml);
my ($ref,$chashref,$listref);
my ($r,@errs);

	if(!exists($args{xml}) || !exists($args{appxml})) {
		return(0,"Missing mandatory argument (requires xml,appxml)");
	}
	$xml=$args{xml};
	$appxml=$args{appxml};

	if(!exists($appxml->{networks}) || !exists($appxml->{networks}->{network})) {
		return(1);	# no networks - no work to do!
	}

	$ref=ref($appxml->{networks}->{network});
	if($ref eq "HASH") {
		$listref=[$appxml->{networks}->{network}];
	} else {
		$listref=$appxml->{networks}->{network};
	}

	#################################################################
	# For each hash reference allocate IP's for that network.	#
	#################################################################
	my %oargs=();
	if(exists($args{rebuild}) && defined($args{rebuild}) && $args{rebuild}) {
		$oargs{rebuild}=1;
	}
	for $chashref (@$listref) {
		if(exists($chashref->{net})) {
			($r,@errs)=CLNET_assign_network_ips(%args,network=>$chashref->{net},%oargs);
			if(!$r) {
				return(0,"Errors whilst allocating IP addresses for network ".$chashref->{net},@errs);
			}
		}
	}
	return(1);
}

#########################################################################
# unassign_ips(xml=>xml,appxml=>appxml)					#
# Use the unassign_network_ips routine to unassign all IP addresses 	#
# across all networks defined for the specified application on the	#
# local host.								#
# Returns(1) - ok, or (0,err,...) if errors.				#
#########################################################################

sub CLNET_unassign_ips {
my %args=@_;
my ($xml,$appxml);
my ($ref,$chashref,$listref);
my ($r,@errs);

	if(!exists($args{xml}) || !exists($args{appxml})) {
		return(0,"Missing mandatory argument (requires xml,appxml)");
	}
	$xml=$args{xml};
	$appxml=$args{appxml};

	if(!exists($appxml->{networks}) || !exists($appxml->{networks}->{network})) {
		return(1);	# no networks - no work to do!
	}

	$ref=ref($appxml->{networks}->{network});
	if($ref eq "HASH") {
		$listref=[$appxml->{networks}->{network}];
	} else {
		$listref=$appxml->{networks}->{network};
	}

	#################################################################
	# For each hash reference allocate IP's for that network.	#
	#################################################################
	for $chashref (@$listref) {
		if(exists($chashref->{net})) {
			($r,@errs)=CLNET_unassign_network_ips(%args,network=>$chashref->{net});
			if(!$r) {
				return(0,"Errors whilst unallocating IP addresses for network ".$chashref->{net},@errs);
			}
		}
	}
	return(1);
}

#########################################################################
# check_ping(xml=>xml,appxml=>appxml,[pingtype=>"icmp",pingtimeout=>2])	#
# Will return error/failure (0,err,...) if the required ping of the	#
# one or more primary IP addresses on the networks associated with this	#
# application are currently in use.					#
# Otherwise will return (1)						#
#########################################################################

sub CLNET_check_ping {
my %args=@_;
my ($xml,$appxml,$pingtype,$pingtimeout);
my ($p,$ref,$listref,$cnet);

	if(!exists($args{xml}) || !exists($args{appxml})) {
		return(-1,"Missing mandatory argument (requires xml,appxml)");
	}
	$xml=$args{xml};
	$appxml=$args{appxml};
	$pingtype="icmp";
	$pingtimeout=2;
	$pingtype=$args{pingtype} if exists($args{pingtype});
	$pingtimeout=$args{pingtimeout} if exists($args{pingtimeout});

	#################################################################
	# Get a list of the nets for this application...		#
	#################################################################

	if(!exists($appxml->{networks}) || !exists($appxml->{networks}->{network})) {
		return(1);	# no networks - no work to do!
	}

	$ref=ref($appxml->{networks}->{network});
	if($ref eq "HASH") {
		$listref=[$appxml->{networks}->{network}];
	} else {
		$listref=$appxml->{networks}->{network};
	}

	#################################################################
	# We the list of networks, stopping at every network where	#
	# checking exists - all networks are checked here...		#
	#################################################################

	$p=Net::Ping->new(lc($pingtype),$pingtimeout);
	for $cnet (@$listref) {
		my ($netname,$ip);

		$netname=$cnet->{net};
		$ip=$cnet->{ip};
		$ip=~s/,.*//;
		if($p->ping($ip)) {
			return(0,"Ip address $ip for network $netname already exists.");
		}
	}
	return(1);
}

#########################################################################
# migrate_ips(xml=>$xml,network=>net,card=>newcard)			#
# This will migrate all IPs from the current interface defined for 	#
# the network to the specified card.					#
# It will return (1) or (0,error,...).					#
# The caller is responsible for getting/releasing a NET lock.		#
#########################################################################

sub CLNET_migrate_ips {
my %args=@_;
my ($net,$xml,$card);
my ($c_card,$cc,$ipinters);
my ($dcmd,$acmd,$acard,$aip,@alist);

	if(!exists($args{xml}) || !exists($args{network}) || !exists($args{card})) {
		return(0,"Missing mandatory argument (requires xml,network,card)");
	}
	$xml=$args{xml};
	$net=$args{network};
	$card=$args{card};

	($res,$acard,$aip)=CLNET_check_one_ip(network=>$net,xml=>$xml);

	if(!$res) {
		return(0,$acard);
	}

	$ipinters=new ipinterfaces;
	$c_card=$ipinters->get_details(interface=>"$acard:0");
	$dcmd="ifconfig $acard inet 0.0.0.0 down 2>&1; ";
	$acmd="ifconfig $card inet $aip ";
	$acmd.="netmask ".$c_card->{netmask}." " if(exists($c_card->{netmask}) && defined($c_card->{netmask}));
	$acmd.="broadcast ".$c_card->{broadcast}." " if(exists($c_card->{broadcast}) && defined($c_card->{broadcast}));
	$acmd.="up 2>&1; ";

	push @alist,$card;

	#################################################################
	# We now get the list of logical interfaces for $acard		#
	# We do not need to take the logical interfaces down, since the	#
	# physical interface does that.					#
	#################################################################
	my $nn;
	my @l=$ipinters->list(logical=>1);
	for $cc (@l) {
		($nn)=($cc =~ /.*:(.*)/);
		$c_card=$ipinters->get_details(interface=>$cc);
		next if !defined($c_card);
		$acmd.="ifconfig $card:$nn inet ".$c_card->{ip}." ";
		$acmd.="netmask ".$c_card->{netmask}." " if(exists($c_card->{netmask}) && defined($c_card->{netmask}));
		$acmd.="broadcast ".$c_card->{broadcast}." " if(exists($c_card->{broadcast}) && defined($c_card->{broadcast}));
		$acmd.="up 2>&1; ";
		push @alist,"$card:$nn";
	}

	my @routes;
	@routes=$ipinters->get_routes(interface=>$acard);
	#################################################################
	# The dcmd contains the code to remove the interfaces .. and	#
	# acmd to allocate them on the new card.			#
	#################################################################

	$r=`$dcmd`;
	$r=`$acmd`;
	if(defined(defined(&miitoollib::send_arp))) {
		miitoollib::send_arp($_) for (@alist);
	} elsif(-x "/sbin/cluster/tools/send_arp") {
		`/sbin/cluster/tools/send_arp $_ 2>&1` for (@alist);
	}
	$ipinters->set_routes(interface=>$card,routes=>\@routes);
	return(1);
}

sub CLNET_map_ip_to_network {
my %args=@_;
my ($ip,$fd,@F);
	if(!exists($args{ip})) {
		return(undef,"Missing mandatory argument (requires ip)");
	}
	if(! -f "/etc/cluster/.networks") {
		return ("?unknown?","/etc/cluster/.networks file does not exist!");
	}
	$ip=$args{ip};
	open($fd,"/etc/cluster/.networks") or
		return("?unknown?","Unable to open /etc/cluster/.networks file.");
	while(<$fd>) {
		chomp;
		@F=split(/:/,$_);
		if($F[2] eq $ip) {
			close($fd);
			return($F[1],undef);
		}
	}
	close($fd);
	return("?unknown?","Specified IP address not found in /etc/cluster/.networks file!");
}

1;

